dim ws : set ws = CreateObject("WScript.Shell")
dim varName : varName = "CurrentLayer"
dim regPath : regPath ="HKCU\PADS_INI\" & varName
dim varValue : varValue = ws.RegRead(regPath)

dim lyrname

dim doc,v
set doc=application.activedocument
'set v = doc.ActiveViews
dim x1,x2,y1,y2
dim unit,unit_str
unit = doc.Unit
doc.Unit = 2 'mil
dim dx
dim dy
dx = 8
dy = 8

unit_str = "mil"
dim gridx 
gridx = doc.gridX
dim sellyr
dim pins,pin
set pins = doc.getobjects(3,,true)
if pins.count =1 then
	
	Application.ModelessCmd("g0")
	Application.ModelessCmd("gd0")
	Application.StatusBarText = "Set Grids = 0"

	for each pin in pins
		sellyr =pin.component.layer		
		xc = pin.positionX
		yc = pin.positionY	
		doc.ActiveView.pan xc,yc
		doc.ActiveView.SetExtentsToSelection
		x0 = doc.ActiveView.TopLeftX
		y0 = doc.ActiveView.TopLeftY
		x1 = doc.ActiveView.BottomRightX
		y1 = doc.ActiveView.BottomRightY
		'MsgBox "View is (" & x0 & ", " & y0 & ") - (" & x1 & ", " & y1 & ")" 
		
		x_len = abs(x1-x0)
		y_len = abs(y1-y0)
		exit for
	next
	
	x1 = xc-dx	
	x2 = xc+dx	
	y1 = yc-y_len*0.5-dy
	y2 = yc+y_len*0.5+dy

	dim tmpfile
	tmpfile = doc.path & "\tmp1.mcr"

	lyrname = doc.LayerName(sellyr)
	dim ostr
	ostr = "" & chr(13) & chr(10)
	ostr = ostr & "Application.HideBar(""Design Toolbar"")" & chr(13) & chr(10)
	ostr = ostr & "Application.ShowBar(""Drafting Toolbar"")" & chr(13) & chr(10)
	ostr = ostr & "Application.ExecuteCommand(""Add Copper Polyline"")" & chr(13) & chr(10)
	ostr = ostr & "Application.ExecuteCommand(""Drafting Rectangle Mode"")" & chr(13) & chr(10)
	ostr = ostr & "Application.ExecuteCommand(""Down"", " & x1 & unit_str & ", " & y1 & unit_str & ")" & chr(13) & chr(10)
	ostr = ostr & "Application.ExecuteCommand(""Select"", " & x1 & unit_str & ", " & y1 & unit_str & ")" & chr(13) & chr(10)
	ostr = ostr & "Application.ExecuteCommand(""Add Corner To Drafting"", " & x1 & unit_str & ", " & y1 & unit_str & ") "& chr(13) & chr(10)
	ostr = ostr & "Application.ExecuteCommand(""Add Corner To Drafting"", " & x2 & unit_str & ", " & y2 & unit_str & ") "& chr(13) & chr(10)
	if application.version=9.5 then
		ostr = ostr & "DraftingPropertiesDlg.CopperPourAndPlaneArea = true" & chr(13) & chr(10)
	else
		ostr = ostr & "DraftingPropertiesDlg.CopperPlane = true" & chr(13) & chr(10)
	end if	
	ostr = ostr & "DraftingPropertiesDlg.LayerName = """ & lyrname & """" & chr(13) & chr(10)
	ostr = ostr & "DraftingPropertiesDlg.Ok.Click()" & chr(13) & chr(10)

	Dim fso,fw
	Set fso = CreateObject("scripting.filesystemobject")
	Set fw = fso.CreateTextFile(tmpfile,True)
	fw.Write ostr
	fw.close
	Set fw = Nothing	
	Set fso = Nothing			
	application.RunMacro(tmpfile,"")
	
	Application.ExecuteCommand("Complete Drafting")
	Application.ExecuteCommand("Cancel")
	Application.ModelessCmd("g " & gridx)
	Application.ModelessCmd("gd " & gridx)
	Application.StatusBarText = "Set Grids = " & gridx
	
	
	'Application.ExecuteCommand("Quick Filter Anything")
	Application.ExecuteCommand("Filter")
	SelectionFilterDlg.Nothing.Click()
	SelectionFilterDlg.SelectionObjectsDlg.Edges = true
	SelectionFilterDlg.Ok.Click()

	Application.StatusBarText = "Select Edges"
	'ApplicationMode=1 ' route
	varName = "ApplicationMode"
	varValue = 1 
	ws.RegWrite "HKEY_CURRENT_USER\Software\MyApp\PADS\" & varName, varValue, "REG_EXPAND_SZ"
	ws.RegWrite "HKEY_CURRENT_USER\Software\MyApp\PADS\Strentch", 1, "REG_EXPAND_SZ"
	
else
	Application.StatusBarText = "Please select only one pin!"
end if
set ws = nothing